home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / BALANC.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  46 lines
  1. PROCEDURE balanc(VAR a: glnpnp; n: integer);
  2. (* Programs using routine BALANC should define the type
  3. TYPE
  4.    glnpnp = ARRAY [1..np,1..np] OF real;
  5. where 'np by np' is the physical dimension of the array to be analyzed. *)
  6. CONST
  7.    radix=2.0;
  8. VAR
  9.    last,j,i: integer;
  10.    s,r,g,f,c,sqrdx: real;
  11. BEGIN
  12.    sqrdx := sqr(radix);
  13.    REPEAT
  14.       last := 1;
  15.       FOR i := 1 TO n DO BEGIN
  16.          c := 0.0;
  17.          r := 0.0;
  18.          FOR j := 1 TO n DO
  19.             IF (j <> i) THEN BEGIN
  20.                c := c+abs(a[j,i]);
  21.                r := r+abs(a[i,j])
  22.             END;
  23.          IF ((c <> 0.0) AND (r <> 0.0)) THEN BEGIN
  24.             g := r/radix;
  25.             f := 1.0;
  26.             s := c+r;
  27.             WHILE (c < g) DO BEGIN
  28.                f := f*radix;
  29.                c := c*sqrdx
  30.             END;
  31.             g := r*radix;
  32.             WHILE (c > g) DO BEGIN
  33.                f := f/radix;
  34.                c := c/sqrdx
  35.             END;
  36.             IF ((c+r)/f < 0.95*s) THEN BEGIN
  37.                last := 0;
  38.                g := 1.0/f;
  39.                FOR j := 1 TO n DO a[i,j] := a[i,j]*g;
  40.                FOR j := 1 TO n DO a[j,i] := a[j,i]*f
  41.             END
  42.          END
  43.       END;
  44.    UNTIL (last <> 0)
  45. END;
  46.